home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbfaqr01.zip / DECODER.BAS < prev    next >
BASIC Source File  |  1992-07-13  |  5KB  |  167 lines
  1. ' Huffman decoder v2.00 for PDS & QB4.5
  2. ' by Rich Geldreich May 29th, 1992
  3. ' Revised for PDS July 13, 1992
  4. ' This program is in the public domain.
  5. ' QB4.5 users: use search & replace and change all of the "SSEG" strings
  6. ' in this program to "VARSEG" strings.
  7. ' Do not press ctrl+break while this program is decompressing! The string
  8. ' pointers may change, which may result in an error! Also, to realize
  9. ' the true speed of this program you must run it compiled!
  10. ' See HUFFMAN2.BAS for info.
  11. DEFINT A-Z
  12.  
  13. DECLARE FUNCTION GetBit ()
  14. DECLARE SUB FillBuff ()
  15.  
  16. CONST True = -1, False = 0
  17. CONST Null = -2
  18. CONST BufferLength = 10000
  19.  
  20. DIM SHARED Bits(8)
  21. DIM SHARED Father(512)
  22. DIM SHARED LeftSon(512)
  23. DIM SHARED RightSon(512)
  24.  
  25. DIM SHARED Buffer$, Address, EndAddress, CurrentByte, BitsIn, BufferSeg
  26.  
  27. Bits:
  28.     DATA 1,2,4,8,16,32,64,128,256
  29.  
  30. RESTORE Bits
  31. FOR A = 0 TO 8: READ Bits(A): NEXT
  32. 'disk buffer
  33. Buffer$ = STRING$(BufferLength, 0): EndAddress = 1: Address = 0: BitsIn = -1
  34. 'turn on cursor
  35. LOCATE , , 1
  36. 'open the compressed file
  37. OPEN "output.huf" FOR BINARY AS #1
  38. 'get the header
  39. GET #1, , FileLength&
  40. GET #1, , RealIndex
  41. GET #1, , TopOfTree
  42. 'read in the tree
  43. FOR A = 0 TO RealIndex
  44.     IF GetBit THEN
  45.         Father = 0
  46.         FOR C = 0 TO 7
  47.             IF GetBit THEN Father = Father + Bits(C)
  48.         NEXT
  49.         Father(A) = Father
  50.         RightSon(A) = Null
  51.         LeftSon(A) = Null
  52.     ELSE
  53.         Father(A) = 256
  54.         IF GetBit THEN
  55.             Son = 0
  56.             FOR C = 0 TO 8
  57.                 IF GetBit THEN Son = Son + Bits(C)
  58.             NEXT
  59.             LeftSon(A) = Son
  60.         ELSE
  61.             LeftSon(A) = Null
  62.         END IF
  63.         IF GetBit THEN
  64.             Son = 0
  65.             FOR C = 0 TO 8
  66.                 IF GetBit THEN Son = Son + Bits(C)
  67.             NEXT
  68.             RightSon(A) = Son
  69.         ELSE
  70.             RightSon(A) = Null
  71.         END IF
  72.     END IF
  73. NEXT
  74. 'when PrintCounter=1024 then screen is updated
  75. PrintCounter = 0
  76. 'A$ is the output buffer
  77. A$ = STRING$(5000, 0)
  78. A& = SADD(A$)
  79. A& = A& - 65536 * (A& < 0)
  80. OutputSeg = SSEG(A$) + (A& \ 16)
  81. OAddress = (A& MOD 16)
  82. OEndAddress = OAddress + 5000
  83. OStart = OAddress
  84. 'start decoding
  85. PRINT "Decoding:";
  86. Xpos = POS(0): Ypos = CSRLIN
  87. 'open output file
  88. OPEN COMMAND$ FOR BINARY AS #2
  89. 'decode each byte
  90. FOR CurrentByte& = 1 TO FileLength&
  91.     DEF SEG = BufferSeg
  92.     'start at top of tree
  93.     A = TopOfTree
  94.     'keep on getting bits until a character is found
  95.     DO
  96.         'if BitsIn<0 then time to fill byte buffer
  97.         IF BitsIn < 0 THEN
  98.             Address = Address + 1
  99.             'if Address=EndBuffer then time to fill disk buffer
  100.             IF Address = EndAddress THEN
  101.                 FillBuff
  102.             END IF
  103.             CurrentByte = PEEK(Address): BitsIn = 7
  104.         END IF
  105.         'see if we go left or right
  106.         IF (CurrentByte AND Bits(BitsIn)) THEN A = LeftSon(A) ELSE A = RightSon(A)
  107.         BitsIn = BitsIn - 1
  108.         F = Father(A)
  109.         'loop until an ascii character is found
  110.     LOOP UNTIL F < 256
  111.     'put byte into output buffer
  112.     DEF SEG = OutputSeg
  113.     POKE OAddress, F
  114.     OAddress = OAddress + 1
  115.     IF OAddress = OEndAddress THEN
  116.         PUT #2, , A$
  117.         A& = SADD(A$)
  118.         A& = A& - 65536 * (A& < 0)
  119.         OutputSeg = SSEG(A$) + (A& \ 16)
  120.         OAddress = (A& MOD 16)
  121.         OEndAddress = OAddress + 5000
  122.         OStart = OAddress
  123.     END IF
  124.     'see if time to update the screen
  125.     PrintCounter = PrintCounter + 1
  126.     IF PrintCounter = 1024 THEN
  127.         PrintCounter = 0
  128.         LOCATE Ypos, Xpos
  129.         PRINT (CurrentByte& * 100) \ FileLength&; "%";
  130.     END IF
  131. 'loop until all of the characters have been restored
  132. NEXT
  133. 'save whatever is currently in the output buffer
  134. A$ = LEFT$(A$, OAddress - OStart)
  135. PUT #2, , A$
  136. CLOSE
  137. 'all done
  138. LOCATE Ypos, Xpos
  139. PRINT " done."
  140.  
  141. END
  142.  
  143. 'fills the input buffer
  144. SUB FillBuff
  145.     GET #1, , Buffer$
  146.     A& = SADD(Buffer$)
  147.     A& = A& - 65536 * (A& < 0)
  148.     BufferSeg = SSEG(Buffer$) + (A& \ 16)
  149.     Address = (A& MOD 16)
  150.     EndAddress = Address + BufferLength
  151.     DEF SEG = BufferSeg
  152. END SUB
  153.  
  154. 'gets one bit from the input file(only used when the tree
  155. 'is read in)
  156. FUNCTION GetBit STATIC
  157.     IF BitsIn < 0 THEN
  158.         Address = Address + 1
  159.         IF Address = EndAddress THEN
  160.             FillBuff
  161.         END IF
  162.         CurrentByte = PEEK(Address): BitsIn = 7
  163.     END IF
  164.     GetBit = (CurrentByte AND Bits(BitsIn)): BitsIn = BitsIn - 1
  165. END FUNCTION
  166.  
  167.